home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog6.arj / POPUP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  2.2 KB  |  91 lines
  1. { Popup.pas -- Create a floating popup menu }
  2.  
  3. program Popup;
  4.  
  5. uses WinTypes, WinProcs, WObjects;
  6.  
  7. const
  8.  
  9.   cm_Item1  = 100;    { Popup menu command IDs }
  10.   cm_Item2  = 101;
  11.   cm_Quit   = 102;
  12.  
  13. type
  14.  
  15.   PopupApplication = object(TApplication)
  16.     procedure InitMainWindow; virtual;
  17.   end;
  18.  
  19.   PPopupWindow = ^PopupWindow;
  20.   PopupWindow = object(TWindow)
  21.     procedure CMItem1(var Msg: TMessage);
  22.       virtual cm_First + cm_Item1;
  23.     procedure CMItem2(var Msg: TMessage);
  24.       virtual cm_First + cm_Item2;
  25.     procedure CMQuit(var Msg: TMessage);
  26.       virtual cm_First + cm_Quit;
  27.     procedure WMRButtonDown(var Msg: TMessage);
  28.       virtual wm_First + wm_RButtonDown;
  29.   end;
  30.  
  31.  
  32. { PopupApplication }
  33.  
  34. {- Initialize PopupApplication object's window }
  35. procedure PopupApplication.InitMainWindow;
  36. begin
  37.   MainWindow := New(PPopupWindow,
  38.     Init(nil, 'Click right mouse button for menu'))
  39. end;
  40.  
  41.  
  42. { PopupWindow commands }
  43.  
  44. procedure PopupWindow.CMItem1(var Msg: TMessage);
  45. begin
  46.   MessageBox(HWindow, 'Item #1', 'Message', mb_Ok)
  47. end;
  48.  
  49. procedure PopupWindow.CMItem2(var Msg: TMessage);
  50. begin
  51.   MessageBox(HWindow, 'Item #2', 'Message', mb_Ok)
  52. end;
  53.  
  54. procedure PopupWindow.CMQuit(var Msg: TMessage);
  55. begin
  56.   CloseWindow
  57. end;
  58.  
  59. {- Create, display, use, and destroy the floating menu }
  60. procedure PopupWindow.WMRButtonDown(var Msg: TMessage);
  61. var
  62.   P: TPoint;            { Sets menu location at mouse pointer }
  63.   PopupMenuH: HMenu;    { Popup menu handle }
  64. begin
  65.   PopupMenuH := CreatePopupMenu;
  66.   AppendMenu(PopupMenuH, mf_Enabled, cm_Item1, 'Item 1');
  67.   AppendMenu(PopupMenuH, mf_Enabled, cm_Item2, 'Item 2');
  68.   AppendMenu(PopupMenuH, mf_Enabled, cm_Quit, 'E&xit');
  69.   P.X := Msg.LParamLo;
  70.   P.Y := Msg.LParamHi;
  71.   ClientToScreen(HWindow, P);
  72.   TrackPopupMenu(PopupMenuH, 0, P.X, P.Y, 0, HWindow, nil);
  73.   DestroyMenu(PopupMenuH)
  74. end;
  75.  
  76. var
  77.  
  78.   PopupApp: PopupApplication;
  79.  
  80. begin
  81.   PopupApp.Init('PopupApp');
  82.   PopupApp.Run;
  83.   PopupApp.Done
  84. end.
  85.  
  86.  
  87. {--------------------------------------------------------------
  88.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  89.   Revision 1.00    Date: 2/20/1991
  90. ---------------------------------------------------------------}
  91.